perm filename RHYC.F4[LCS,MUS] blob
sn#030354 filedate 1973-03-19 generic text, type T, neo UTF8
00100 C FILE NAME='RHYC'
00200
00300 C THIS IS FOR RHYTHMIC INPUT FROM BUTTONS.
00400 C ORDER FOR EDITING WITH 'CONDUCT'.
00500 C 1. GET LISTING. 2. ADD,DELETE,CHANGE DURATIONS,TEMPO,METER.
00600 C 3. QUICK TEMPO CHANGES MUST COME LAST!
00700
00800 DIMENSION IV(200),V(200),W(600)
00900 COMMON V,N
01000 1700 BB=.1
01100 1032 TYPE 1000
01200 32 X=0
01300 I=1
01400 J=1
01500 1000 FORMAT(' INFO? OR WHAT?'/)
01600 ACCEPT 50,N
01700 50 FORMAT(A1)
01800 IF(N.EQ.'I')TYPE 2000
01900 IF(N.EQ.'I')GO TO 1032
02000 2000 FORMAT(' COMMANDS: R(EAD), S(AVE), L(IST), C(ONDUCT),
02100 1 E(DIT), TAP=<CR>'/' ALL RESTS, AS WELL AS NOTES, MUST BE
02200 1 TAPPED.'/' IF THERE ARE NO TAPS FOR 10" THE LAST TAP IS TAKEN AS
02300 1 THE TERMINATION OF THE INPUT.'/)
02400 IF((N.EQ.'R').OR.(N.EQ.'S'))GO TO 6
02500 IF(N.EQ.'E')GO TO 1013
02600 IF(N.EQ.'L')GO TO 24
02700 3001 TYPE 1001
02800 1001 FORMAT(' TAP ONCE, THEN PLAY RHYTHM'/)
02900 CALL RHYTHM(V,II)
03000 DO 2001 K=II+1,200
03100 2001 V(K)=0
03200 A=0
03300 L=1
03400 IF(N.EQ.'C')L=2
03500 DO 1021 K=L,II
03600 1021 A=A+V(K)
03700 2021 FORMAT(I4,' NOTES ',F8.3,'"'/)
03800 L=II
03900 IF(N.EQ.'C')L=L-1
04000 TYPE 2021,L,A
04100 21 FORMAT(2F)
04200 TYPE 12
04300 12 FORMAT(' OK=0,TRY AGAIN=1'/)
04400 ACCEPT 5,K
04500 ICON=0
04600 IF(K.EQ.1)GO TO 3001
04700 IF(N.NE.'C')GO TO 1032
04800 C WHEN 'CONDUCTING', UPBEAT MUST BE TAPPED.
04900 C METER OF UPBEAT (NOTE #0) MAY BE RESET.
05000 ALLM=1.
05100 ICON=-1
05200 3012 Q=ALLM
05300 DO 2012 K=3,II*3,3
05400 2012 W(K)=Q
05500 IF(ALLM.EQ.X)GO TO 300
05600 GO TO 1032
05700 24 IF(ICON)GO TO 100
05800 9024 N=0
05900 7024 FORMAT(/' DURATIONS OF NOTES',18XA5,12X,'TOTAL=',F7.3,' SECS.'/)
06000 8024 FORMAT(' NOTE 0 IS UPBEAT (NOT INCLUDED IN DURATION)')
06100 L=0
06200 IF(ICON)L=1
06300 K=1-L
06400 PRINT 7024,QSLAC,A
06500 IF(ICON)PRINT 8024
06600 DO 14 LL=1,40
06700 KA=K+1
06800 KB=KA+1
06900 KC=KB+1
07000 KD=KC+1
07100 PRINT 15,K,V(K+L),KA,V(KA+L),KB,V(KB+L),KC,V(KC+L),KD,V(KD+L)
07200 DO 16 M=1,5
07300 IF((V(K+M+L).EQ.0).OR.(V(K+M+L).EQ.999.0))GO TO 15
07400 16 CONTINUE
07500 14 K=K+5
07600 15 FORMAT(5(' (',I3,')',F7.3)/)
07700 CALL EXIT
07800
07900 1013 TYPE 17
08000 17 FORMAT(' TYPE C(HANGE), A(DD NOTE), D(ELETE), T(EMPO CHANGE),
08100 1'/' M(ETER CHANGE), Q(UICK CHANGE), J(OIN), S(PLIT) OR <CR>'/)
08200 ACCEPT 50,K
08300 IF(K.EQ.'-1')GO TO 1013
08400 C WITH 'CONDUCT', ADDED BEATS ARE IN TERMS OF REAL TIME.
08500 IF(K.EQ.'M')GO TO 101
08600 IF((K.NE.'C').AND.(K.NE.'Q'))GO TO 18
08700 TYPE 19
08800 19 FORMAT(' TYPE NOTE N'/)
08900 ACCEPT 5,KA
09000 IF(KA)GO TO 1013
09100 IF(K.EQ.'Q')GO TO 120
09200 L=KA
09300 IF(ICON)KA=KA+1
09400 TYPE 20,L,V(KA)
09500 20 FORMAT(' NOTE',I3,' WAS',F9.4,', CHANGE TO ',$)
09600 X=V(KA)
09700 ACCEPT 21,V(KA)
09800 IF(V(KA).LE.0)V(KA)=X
09900 A=A+V(KA)-X
10000 IF(ICON+1)GO TO 300
10100 GO TO 1013
10200 220 FORMAT(' BEAT',I3,', TF1=',F5.3,', TF2=',F5.3,/
10300 1 ' CHANGE TF1 TO ',$)
10400 120 L=KA*3+1
10500 TYPE 220,KA,W(L),W(L+1)
10600 ACCEPT 21,Y
10700 IF(Y.LE.0)GO TO 1013
10800 X=W(L+1)+W(L)-Y
10900 W(L)=Y
11000 W(L+1)=X
11100 KA=KA+2
11200 LA=L+2
11300 GO TO 1300
11400 C QUICK CHANGES MUST BE DONE LAST. THEY ARE WIPED OUT WHEN ANY OTHER EDITING IS DONE!
11500 C THEY MUST BE IN ORDER FROM 1 TO END.
11600
11700 18 IF(K.NE.'A')GO TO 22
11800 TYPE 23
11900 23 FORMAT(' ADD AFTER WHICH NOTE?'/)
12000 ACCEPT 5,K
12100 IF(K)GO TO 1013
12200 IF(ICON)K=K+1
12300 TYPE 25
12400 25 FORMAT(' TYPE NOTE VALUE'/)
12500 ACCEPT 21,X
12600 IF(X.LE.0)GO TO 18
12700 A=A+X
12800 125 II=II+1
12900 IF(ICON)W((II-1)*3)=1.
13000 L=II+10
13100 DO 26 M=L,1,-1
13200 V(M)=V(M-1)
13300 IF(M-1.NE.K)GO TO 26
13400 V(M)=X
13500 C 'METERS' MUST BE CHECKED AFTER 'ADD' OR 'DELETE' IS USED.
13600 IF(ICON)GO TO 2300
13700 GO TO 1013
13800 26 CONTINUE
13900 GO TO 1032
14000
14100 22 IF(K.NE.'D')GO TO 229
14200 TYPE 28
14300 28 FORMAT(' DELETE WHICH NOTE?'/)
14400 ACCEPT 5,K
14500 IF(K)GO TO 1013
14600 IF(ICON)K=K+1
14700 A=A-V(K)
14800 429 II=II-1
14900 C KII WAS 1 IN NEXT LINE.
15000 DO 29 KA=K,II
15100 29 V(KA)=V(KA+1)
15200 V(II+1)=0
15300 IF(ICON)GO TO 2300
15400 GO TO 1013
15500 229 IF(K.NE.'J')GO TO 329
15600 C JOINS NOTE TO FOLLOWING NOTE.
15700 TYPE 19
15800 ACCEPT 5,K
15900 IF(ICON)K=K+1
16000 V(K)=V(K)+V(K+1)
16100 K=K+1
16200 GO TO 429
16300
16400 329 FORMAT(' TYPE % FOR 1ST NOTE.'/)
16500 IF(K.NE.'S')GO TO 35
16600 C SPLITS NOTE BY %S.
16700 TYPE 19
16800 ACCEPT 5,K
16900 L=K
17000 IF(ICON)K=K+1
17100 TYPE 329
17200 ACCEPT 21,X
17300 Y=V(K)*X
17400 X=V(K)-Y
17500 V(K)=Y
17600 LA=L+1
17700 TYPE 529,L,V(K),LA,X
17800 529 FORMAT(2(' NOTE',I3,' =',F6.3/))
17900 GO TO 125
18000
18100 410 KB=II
18200 KC=II
18300 KA=1
18400 1410 G=3.9
18500 ICNT=1
18600 LL='9'
18700 IF(KB.GT.51)KB=51
18800 KC=KC-KB
18900 KD=KB*2
19000 310 KK=9
19100 L=-1
19200 C WATCH ARRAY LENGTHS HERE.
19300 J=KB
19400 IF(KA.GT.1)J=J+3
19500 DO 210 K=KA*3+1,(J+KA-1)*3-1,3
19600 X=W(K)
19700 Y=W(K+1)
19800 L=L+2
19900 IV(L)='. '
20000 IV(L+1)=' '
20100 IF(L.NE.KK)GO TO 1210
20200 2210 IV(L)=-2147483648
20300 KK=KK+10
20400 1210 IF((Y.LT.G+.05).AND.(Y.GT.G-.05))IV(L+1)=LL
20500 210 IF((X.LT.G+.05).AND.(X.GT.G-.05))IV(L)=LL
20600 X=' '
20700 IF(ICNT.EQ.10)X=' 180'
20800 IF(ICNT.EQ.15)X=' 150'
20900 IF(ICNT.EQ.20)X=' 120'
21000 IF(ICNT.EQ.30)X=' 60'
21100 IF(ICNT.EQ.25)X=' 90'
21200 IF(ICNT.EQ.5)X=' 210'
21300 IF(ICNT.EQ.33)X=' 42'
21400 PRINT 110,X,G,(IV(K),K=1,KD)
21500 ICNT=ICNT+1
21600 110 FORMAT(A4,F5.1,2X102A1)
21700 IF(G.LT..4)GO TO 510
21800 G=G-.1
21900 LL=LL-536870912
22000 C ABOVE MOVES '9' TO '0' ETC.
22100 IF(LL.LT.'0')LL='9'
22200 GO TO 310
22300 510 IF(KA-2)LB='A'
22400 IF(LB.GE.'A')LB=LB-536870912
22500 LL=1
22600 Y=0
22700 M=(KB+KA-1)*3
22800 IF(M-KA*3.GE.150)M=M-1
22900 DO 610 K=KA*3,M,3
23000 IV(LL)=' '
23100 X=W(K)
23200 IF(X.EQ.1.)GO TO 610
23300 IF(X.EQ.Y)GO TO 1610
23400 LB=LB+536870912
23500 Y=X
23600 1610 IV(LL)=LB
23700 610 LL=LL+1
23800 IV(LL)=' '
23900 C WHAT IF LAST BEAT IS NOT 4 16THS?
24000 KD=KB-KA*(1/KA)
24100 PRINT 710,(IV(K),K=1,KD)
24200 710 FORMAT(29X,'10',18X,'20',18X,'30',18X,'40'/11X50A2)
24300 C 200 BEAT LIMIT SO FAR.
24400 LL='A'
24500 X=1.
24600 LA=0
24700 DO 910 K=KA*3,M-1,3
24800 Y=W(K)
24900 L=Y/.25
25000 IF((Y.EQ.X).OR.(Y.EQ.1.).OR.(L.EQ.LA))GO TO 910
25100 LA=L
25200 PRINT 1110,LL,L
25300 LL=LL+536879012
25400 910 X=Y
25500 IF(KC.LE.0)GO TO 9024
25600 KA=KB+KA-1
25700 C CHECK THIS OUT!!
25800 KB=KC
25900 PRINT 2410
26000 GO TO 1410
26100 2410 FORMAT('1')
26200 1110 FORMAT(1XA1,'=',I2,' 16TH NOTES')
26300 35 FORMAT(' TEMPO FACTOR IS 1, CHANGE TO'/)
26400 IF(K.NE.'T')GO TO 1032
26500 TYPE 35
26600 ACCEPT 21,X
26700 IF(X)GO TO 1013
26800 A=0
26900 IF(ICON)A=-V(1)/X
27000 DO 36 K=1,II
27100 V(K)=V(K)/X
27200 36 A=A+V(K)
27300 IF(ICON)GO TO 2300
27400 GO TO 1032
27500
27600 100 IF(ICON+1)GO TO 410
27700 2300 W(1)=980000.
27800 300 W(2)=II*3-2
27900 KA=2
28000 LA=3
28100 X=Q/V(1)
28200 1300 L=LA
28300 DO 1200 K=KA,II
28400 Y=W(L)/V(K)
28500 W(L+1)=Y
28600 W(L+2)=Y
28700 1200 L=L+3
28800 L=LA
28900 3300 DO 500 K=KA,II
29000 Y=W(L)/V(K)
29100 Z=Y
29200 IF(K.LT.II)Z=W(L+4)
29300 B=ABS(Y-X)
29400 C=ABS(Z-Y)
29500 D=B-C/2
29600 IF(Y-X)GO TO 700
29700 IF(Z-Y)GO TO 900
29800 IF(D)GO TO 600
29900 IF(C.GE..05)B=-D
30000 IF(C.LT..05)B=-B*BB
30100 C '.2' IS ARBITRARY. TO SMOOTH JUMPS IN TEMPO.
30200 GO TO 200
30300 700 IF(Z-Y.LE.0)GO TO 800
30400 B=B*.5
30500 GO TO 200
30600 800 IF(D)GO TO 200
30700 IF(C.GE..05)B=D
30800 IF(C.LT..05)B=B*BB
30900 GO TO 200
31000 900 B=-B*.5
31100 GO TO 200
31200 600 B=-B
31300 200 W(L+1)=W(L+1)+B
31400 W(L+2)=W(L+2)-B
31500 X=W(L+2)
31600 500 L=L+3
31700
31800 L=L-1
31900 DO 2100 K=1,7
32000 2100 W(L+K)=999.
32100 ICON=-2
32200 IF(N.EQ.'L')GO TO 410
32300 IF(N.EQ.'E')GO TO 1013
32400 GO TO 2
32500
32600 101 FORMAT(' CHANGE WHICH BEAT?'/)
32700 TYPE 101
32800 ACCEPT 5,KA
32900 C I.E. 3/8 = 4,8 5/16 = 4,16.
33000
33100 TYPE 201
33200 201 FORMAT(' TYPE VALUE OF BEAT'/)
33300 X=0
33400 ACCEPT 5,(IV(K),K=1,8)
33500 DO 301 K=1,8
33600 Y=IV(K)
33700 IF(Y.LT.99.)GO TO 301
33800 ALLM=X
33900 GO TO 3012
34000 C SETS METER FOR ALL BEATS IF LAST NUMBER IS .GE.99.
34100 301 IF(Y.NE.0)X=X+4./Y
34200 W(KA*3)=X
34300 GO TO 300
34400 C FIX SO CHANGES GO FROM THIS POINT ON.
34500 C QUICK CHANGES OF TEMPO MUST BE SET (OR RESET) AFTER! ANY OTHER EDITING.
34600 6 TYPE 2
34700 IF(N.EQ.'R')ICON=0
34800 IF(ICON.EQ.-1)GO TO 100
34900 2 FORMAT(' TYPE NAME'/)
35000 ACCEPT 4,QSLAC
35100 IF(QSLAC.EQ.'-1')GO TO 1032
35200 IF(QSLAC.NE.' ')GO TO 4
35300 QSLAC='BIN'
35400 4 FORMAT(A5)
35500 5 FORMAT(8I)
35600 CALL ZERPP
35700 IF(ICON)GO TO 1005
35800 IF(N.EQ.'R') GO TO 27
35900 DO 102 K=1,II+10
36000 102 W(K)=V(K)
36100 1005 CALL OFILE(1,QSLAC)
36200 10 DO 7 K=1,7
36300 IF(W(I).EQ.0)W(I)=999.0
36400 7 I=I+1
36500 8 WRITE(1,11)(W(K),K=J,J+6)
36600 IF((W(I-1).EQ.999.0).OR.(W(I-1).EQ.0))GO TO 9
36700 J=I
36800 GO TO 10
36900 C 'V' KEEPS BASIC DATA AT ALL TIMES, 'W' WILL HAVE MODIFIED DATA.(98000,WDCNT,TDUR,T1,T2,ETC.)
37000 9 WRITE(1)II,A,V,Q
37100 END FILE 1
37200 CALL EXIT
37300 27 CALL IFILE(1,QSLAC)
37400 30 READ(1,11)(W(K),K=J,J+6)
37500 IF(W(J+6).EQ.999.0)GO TO 6013
37600 J=J+7
37700 GO TO 30
37800 6013 READ(1)II,A,V,Q
37900 IF(W(1).GT.999.)ICON=-2
38000 GO TO 1032
38100 11 FORMAT(1X7F)
38200 111 FORMAT(I,202F)
38300 END